Programming Languages Suite/ProgramD2.iso/Visual Database/Visual BASIC 5.0 (Ent. Edition)/Vb5ent Extractor.EXE/VB/SAMPLES/ENTRPRIS/APE/AEQUEUE/MODQUEUE.BAS

BASIC Source File | 1996-12-23 | 34.5 KB | 715 lines

Attribute VB_Name = "modQueueMgr"
Option Explicit
'-------------------------------------------------------------------------
'The project is the QueueMgr component of the Application Performance Explorer
'The QueueManager receives Service Requests from Client applications and
'places the requests in a Queue.  When it receives a request it passes
'a received callback object to the Expediter if needed.  Workers poll the
'QueueMgr taking Service Requests and accomplishing the service.  When
'the Worker takes a Service request it is removed from the Queue.
'The Queue Manager creates the Worker(s), the Logger, and the Expediter
'
'Key Files:
'   frmQueue.frm    Is the only and main form of the app
'   clsPosFm.cls    Is a tool to save the forms position to the registry
'   clsServc.cls    Is a class used to store Service Request Data
'   clsWorkr.cls    Is a class used to store a Worker object and its related
'                   data
'   QueueMgr.cls    Is a creatable multi-use class that provides the
'                   OLE interface for the APE Manager to call
'   clsQueDl.cls    Is a non-creatable public class that is instanciated and
'                   passed to the Workers and expediter for them to call
'   Queue.cls       Is a creatable multi-use class that provides the OLE
'                   interface for client applications to add service
'                   requests to the Queue
'-------------------------------------------------------------------------

'Declarations
Declare Function GetTickCount Lib "kernel32" () As Long

'U/I Caption ResourceString keys
Public Const giFORM_CAPTI0N As Integer = 101
Public Const giCURRENT_QUEUE_CAPTION As Integer = 102
Public Const giPEAK_QUEUE_CAPTION As Integer = 103
Public Const giTOTAL_CALL_CAPTION As Integer = 104
Public Const giWORKER_COUNT_CAPTION As Integer = 105

'Constants
Public Const gbSHOW_FORM_DEFAULT As Boolean = False
Public Const gbLOG_DEFAULT As Boolean = False
Public Const gsPROTOCOL_DEFAULT As String = "ncacn_ip_tcp"
Public Const glAUTHENTICATION_DEFAULT As Long = 1
Public Const giWORKER_QUANTITY_DEFAULT As Integer = 1
Public Const gbWORKER_EARLYBIND_DEFAULT As Integer = True
Public Const gbPERSISTENT_QUEUE_DEFAULT As Boolean = False
Public Const glMAX_QUEUE_SIZE_DEFAULT As Long = 20000   'This was chosen as the ideal MaxQueue size on
                                                        'on a Pentium 100 with 32 meg, running NT4
                                                        'This allows the queue to get large enough for
                                                        'the user to see a performance hit, but not so
                                                        'large that recovery is difficult
Public Const giERROR_THRESHOLD As Integer = 32700
Public Const glMAX_ID As Long = 2147483647
Public Const giMAX_WORKERS As Integer = 30
Public Const giMAX_ALLOWED_RETRIES  As Integer = 500
Public Const giRETRY_WAIT_MIN  As Integer = 500       'Retry Wait is measure in DoEvent cycles
Public Const giRETRY_WAIT_MAX  As Integer = 2500
Public Const giRESULT_ARRAY_REDIM_CHUNK_SIZE = 20
Public Const giRESULT_ARRAY_MAX_SIZE = 200

Public Const giRACREG_ERROR_CODE_OFFSET = 200               'Add offset to racreg32 error codes
                                                            'to make corresponding resource string key

'Status codes for Status property of clsService
Public Const giCLIENT_IS_ADDING  As Integer = 0     'Client is currently in the Add method for the
                                                    'respective Service reaquest.  The request should
                                                    'not be delegated yet.
Public Const giWAITING_FOR_WORKER As Integer = 1    'Service request is ready to be taken by worker
Public Const giDELEGATED_TO_WORKER  As Integer = 2  'Worker is processing this service request
Public Const giHAVE_SERVICE_RESULTS As Integer = 3  'Worker has returned results for this Service
                                                    'request.  It is ready to be taken by Expediter

'User Defined Errors which also serve as string
'resource indexes
Public Const giQUEUE_MGR_IS_BUSY As Integer = 32749
Public Const giFIRST_GET_WITHEVENTS_OBJECT As Integer = 32763
Public Const giNO_WORKERS_CREATED As Integer = 32764
Public Const giINVALID_PARAMETER As Integer = 32765
Public Const giINVALID_CALLBACK As Integer = 32766
Public Const giCOULD_NOT_CREATE_EXPEDITER As Integer = 32762
Public Const giCONNECTION_SETTING_FAILED As Integer = 32750     'An error was returned by RacReg32

'String resourse strings for logging messages
Public Const giQUEUE_NAME As Integer = 2
Public Const giADD_RECEIVED As Integer = 3
Public Const giGETREQUEST_RECEIVED_NEW_SERVICE As Integer = 4
Public Const giGETREQUEST_RECEIVED_RETURNED_RESULTS As Integer = 5
Public Const giGETRESULTS_RECEIVED_RETURNED_RESULTS As Integer = 6

Public Const giSTOP_TEST_RECEIVED As Integer = 10
Public Const giCALL_REJECTED_RETRY As Integer = 11
Public Const giUSING_NO_AUTHENTICATION As Integer = 12
Public Const giONLY_N_WORKERS_CREATED As Integer = 13
Public Const giCOULD_NOT_CREATE_WORKER_ON_MACHINE As Integer = 14
Public Const giALL_WORKERS_CREATED As Integer = 15
Public Const giCOULD_NOT_CREATE_LOCAL_WORKER As Integer = 16
Public Const giERROR_PREFIX As Integer = 17

Public Const giFONT_CHARSET_INDEX As Integer = 30
Public Const giFONT_NAME_INDEX As Integer = 31
Public Const giFONT_SIZE_INDEX  As Integer = 32

'Global variables
Public glMaxQueueSize As Long  'Maximum allowed size of gcQueue
Public glLastID As Long        'Last Service ID used; for generating a new one
Public glAddCallCount As Long  'Total calls made to Queue.Add
Public glPeakQueueSize As Long 'Largest size of the collection of Service requests
Public gbLog As Boolean        'If True log QueueMgr Events
Public goExpediter As aeexpediter.Expediter  'Expediter class object
Public gcQueue As Collection                 'Collection of clsService class objects
                                             'which contain a data structure for holding
                                             'Service request.
Public gcWorkers As Collection               'Collection of clsWorker class objects
Public gcWorkerMachines As Collection        'Collection of clsWorkerMachines objects used
                                             'keep track of how many worker objects are on
                                             'each remote worker machine.
Public goLogger As aelogger.Logger           'Logger object

Public gbShow As Boolean                     'If True show frmQueueMgr
Public glInstances As Long                   'Count of number of instances
                                             'of this class
Public giWorkerCount As Integer              'Number of Worker instanciated, This can be different
                                             'than gcWorkers.Count if a Worker in the collection
                                             'is marked for removal it will not be included in giWorkerCount
Public glLastKeyUsed As Long                 'Last key used to add a worker to gcWorkers
                                             'It is necessary to use this because a the
                                             'giWorkerCount can be decreased but the Worker
                                             'not actually removed until it calls back after
                                             'completing a Service request.  During this time
                                             'WorkerQuantity can be called again to increase
                                             'the Worker count.  Therefore, giWorkerCount is
                                             'not reliable for generating unique keys
Public gbLogWorkers As Boolean      'Flag to track status of
                                    'Worker property Log
Public gbPersistentServices As Boolean      'Flag keeps track of Worker
                                            'property PersistentServices
                                            'If true Workers keep reference to
                                            'all Service objects used else they
                                            'drop references after each use.
Public gbEarlyBindServices As Boolean       'Flag to track status of
                                            'Worker property EarlyBound
Public gbShowExpediter As Boolean   'Stores current Expediter property Show
Public gbLogExpediter As Boolean    'Stores current Expediter property Log
Public gbStopTest As Boolean        'Stop Test flag, checked by many procedures
                                    'that will discontinue their processes if true
Public gbBusyAdding As Boolean      'If true, in Queue.Add method
Public gbBusyGetServiceRequest As Boolean   'If true, in clsQueueDelegator.GetServiceRequest method
Public gbBusyGetServiceResults As Boolean   'If true, in clsQueueDelegator.GetServiceResults method
Public gbUnloading As Boolean               'Flag used by Class_terminate
Public gbHaveServiceResults As Boolean      'If true, there are Service Request results to return
                                            'to the Expediter when it polls
Public gsProtocol As String                 'Protocol sequence to use when connecting to Workers
Public glAuthentication As Long             'Authentication level to use when connecting to Workers
Public gbUseDCOM As Boolean                 'If true use DCOM to create workers instead of Remote Automation
Public gbFailedToCreateExpediter As Boolean

Sub Main()
End Sub

Public Sub CountInitialize()
    '-------------------------------------------------------------------------
    'Purpose:   Keep track of number instances of QueueMgr and Queue
    '           To be called by a public creatable class in its initialize
    '           event. To keep track of how many public creatable objects
    '           are initialized.  Initialize the QueueMgr application if
    '           this is the first time it is called.
    'Effects:
    '           If this is the first instanciation
    '           Put the QueueMgr in a "Ready" state.  Load expediter, and Workers
    '           Set default properties, Show form and load logger if necessary.
    '   [glInstances]
    '           increments by one
    '-------------------------------------------------------------------------
    Dim i As Integer
    Dim oWork As clsWorker                   'Object storing Workers and related informantion
    Dim oService As clsService               'Object storing service requests and results
    Dim oWorkerMachine As clsWorkerMachines  'Object that stores how many
                                             'Workers are on what machines
    Dim sProgID As String           'ProgID trying to be created
                                    'used for error handling
    Dim sReturn As String           'Return of SetWorkersOnMachine function
    Dim bCreatingExpediter As Boolean

    On Error GoTo CountInitializeError

    glInstances = glInstances + 1
    If glInstances = 1 Then
        App.OleServerBusyRaiseError = True
        App.OleServerBusyTimeout = 10000
        'Set default property values
        gbShow = gbSHOW_FORM_DEFAULT
        gbLog = gbLOG_DEFAULT
        gsProtocol = gsPROTOCOL_DEFAULT
        glAuthentication = glAUTHENTICATION_DEFAULT
        gbEarlyBindServices = gbWORKER_EARLYBIND_DEFAULT
        glMaxQueueSize = glMAX_QUEUE_SIZE_DEFAULT
        'Create Logger class object early so
        'potential errors could be logged
        sProgID = "AELogger.Logger"
        If gbLog Then Set goLogger = New aelogger.Logger
        'gbPersistentQueue = gbPERSISTENT_QUEUE_DEFAULT
        'Create Expediter class object
        sProgID = "AEExpediter.Expediter"
        bCreatingExpediter = True
        Set goExpediter = New aeexpediter.Expediter
        Set goExpediter.QueueMgrRef = New clsQueueDelegator
        bCreatingExpediter = False
        'Load frmQueueMgr because it has a timer
        Load frmQueueMgr
        'Create collection objects
        Set gcWorkers = New Collection
        Set gcQueue = New Collection
        Set gcWorkerMachines = New Collection
        'Add an item to represent number of workers on the local machine
        Set oWorkerMachine = New clsWorkerMachines
        gcWorkerMachines.Add oWorkerMachine
        'Load the default amount of workers and add
        'them to the gcWorkers Collection
        sReturn = SetWorkersOnMachine(False, "", giWORKER_QUANTITY_DEFAULT)

        'Only show the form if gbShow is true
        If gbShow Then
            frmQueueMgr.Show
            With frmQueueMgr
                .lblCount.Caption = 0
                .lblPeak.Caption = 0
                .lblQueue.Caption = 0
                .lblWorkerCount.Caption = gcWorkers.Count
                .lblCount.Refresh
                .lblPeak.Refresh
                .lblQueue.Refresh
                .lblWorkerCount.Refresh
            End With
        End If
        gbUnloading = False
        'call start test in the  Expediter so it
        'will start polling the QueueMgr
        goExpediter.StartTest
    End If
    Exit Sub
CountInitializeError:
    Select Case Err.Number
        Case ERR_CANT_FIND_KEY_IN_REGISTRY
            'AEInstancer.Instancer is a work around for error
            '-2147221166 which occurrs every time a client
            'object creates an instance of a remote server,
            'destroys it, registers it local, and tries to
            'create a local instance.  The client can not
            'create an object registered locally after it created
            'an instance while it was registered remotely
            'until it shuts down and restarts.  Therefore,
            'it works to call another process to create the
            'local instance and pass it back.
            Dim oInstancer As AEInstancer.Instancer
            Set oInstancer = New AEInstancer.Instancer
            Select Case sProgID
                Case "AELogger.Logger"
                    Set goLogger = oInstancer.Object("AELogger.Logger")
                Case "AEExpediter.Expediter"
                    Set goExpediter = oInstancer.Object("AEExpediter.Expediter")
            End Select
            Set oInstancer = Nothing
            Resume Next
        Case Else
            If bCreatingExpediter Then gbFailedToCreateExpediter = True
            LogError Err, 0
            Resume Next
    End Select
End Sub

Public Sub CountTerminate()
    '-------------------------------------------------------------------------
    'Purpose:   Keep track of number instances of QueueMgr and Queue
    '           To be called by a public creatable class in its terminate
    '           event. To keep track of how many public creatable objects
    '           are initialized.  Terminate the QueueMgr application if
    '           this is the last time called.
    'Effects:
    '           Unload all objects, and unload form so that this application
    '           will close
    '   [glInstances]
    '           decrements by one
    '-------------------------------------------------------------------------
    Dim oWorker As clsWorker
    On Error GoTo Class_TerminateError
    glInstances = glInstances - 1
    'If already started unloading don't check
    'instance count again
    If Not gbUnloading Then
        If glInstances = 0 Then
            gbUnloading = True
            goExpediter.StopTest
            For Each oWorker In gcWorkers
                oWorker.Worker.ShutDown
            Next
            For Each oWorker In gcWorkers
                Set oWorker.Worker = Nothing
                Set oWorker = Nothing
            Next
            Set goLogger = Nothing
            Set gcWorkers = Nothing
            giWorkerCount = 0
            Set gcWorkerMachines = Nothing
            Set goExpediter = Nothing
            Set gcQueue = Nothing
            Unload frmQueueMgr
        End If
    End If
    Exit Sub
Class_TerminateError:
    LogError Err, 0
    Resume Next
End Sub

Public Sub LogEvent(intMessage As Integer, lServiceID As Long)
    '-------------------------------------------------------------------------
    'Purpose:   Receives Message key which is used to look
    '           up a resource string.  The logrecord is sent to the
    '           Logger object if gbLog is true
    'In:        [intMessage]
    '               A valid Resource string key for the message to be logged
    '           [lServiceID]
    '               Service Request ID to be logged
    'Assumption:
    '           If gbLog is true then goLogger is a valid reference to
    '           AELogger.Logger class object
    '-------------------------------------------------------------------------
    On Error GoTo LogEventError
    If gbLog And Not gbStopTest Then
        goLogger.Record LoadResString(giQUEUE_NAME), lServiceID, LoadResString(intMessage), GetTickCount()
    End If
    'If the form is visible display log on form
    #If ccShowList Then
        DisplayString CStr(lServiceID) & gsSEPERATOR & LoadResString(intMessage)
    #End If
    Exit Sub
LogEventError:
    LogError Err, lServiceID
    Exit Sub
End Sub

Public Sub LogText(sMsg As String, lServiceID As Long)
    '-------------------------------------------------------------------------
    'Purpose:   Passes that passed string and ServiceID as a log record
    '           to the logger
    'In:        [sMsg]
    '               String to be logged
    '           [lServiceID]
    '               Service Request ID to be logged
    'Assumption:
    '           If gbLog is true then goLogger is a valid reference to
    '           AELogger.Logger class object
    '-------------------------------------------------------------------------
    On Error GoTo LogTextError
    If gbLog And Not gbStopTest Then
        goLogger.Record LoadResString(giQUEUE_NAME), lServiceID, sMsg, GetTickCount()
    End If
    'If the form is visible display log on form
    #If ccShowList Then
        DisplayString CStr(lServiceID) & gsSEPERATOR & sMsg
    #End If
    Exit Sub
LogTextError:
    LogError Err, lServiceID
    Exit Sub
End Sub

Public Sub LogError(ByVal oErr As ErrObject, lServiceID As Long)
    '-------------------------------------------------------------------------
    'Purpose:   Display error description on forms Status box if the form is
    '           visible; log error if logging is on
    'In:        [oErr]
    '               Valid error object
    '           [lServiceID]
    '               Service Request ID logged with the error message
    'Assumption:
    '           If gbShow is true the form is loaded and visible
    '           If gbLog is true the goLogger is a valid AELogger.Logger class
    '               object
    '-------------------------------------------------------------------------

    Dim s As String
    s = LoadResString(giERROR_PREFIX) & Str$(oErr.Number) & gsSEPERATOR & oErr.Source & gsSEPERATOR & oErr.Description
    #If ccShowList Then
        If Not gbShow Then
            frmQueueMgr.Show
            gbShow = True
        End If
        DisplayString s
    #Else
        If oErr.Number <> 0 Then DisplayStatus oErr.Description
    #End If
    If gbLog And glInstances <> 0 Then
        goLogger.Record LoadResString(giQUEUE_NAME), lServiceID, s, GetTickCount()
    End If
End Sub

Sub DisplayStatus(s As String)
    '-------------------------------------------------------------------------
    'Purpose:   If gbShow is true, displays passed string on forms status box
    'Assumes:   If gbShow is true, form is loaded and visible
    '-------------------------------------------------------------------------
    If gbShow Then frmQueueMgr.lblStatus = s
End Sub

Sub DisplayString(sText As String)
    '-------------------------------------------------------------------------
    'Purpose:   Adds the passed text to to the list box.  Only used if conditional
    '           compile ccShowList is true.
    'Assumes:   If gbShow is true, form is visible
    '           If ccShowList is true, lstLog is visible and positioned
    '-------------------------------------------------------------------------
    'Controls the length of the list box
    'and sets ListIndex
    #If ccShowList Then
        Dim lstLog As ListBox
        If gbShow Then
            Set lstLog = frmQueueMgr.lstLog
            If lstLog.ListCount = giLIST_BOX_MAX Then lstLog.Clear
            lstLog.AddItem sText, 0
            DoEvents
        End If
    #End If
End Sub

Function gFormatPath(sPath As String) As String
    '-------------------------------------------------------------------------
    'Purpose:   Assures that the passed path has a "\" at the end of it
    'IN:
    '   [sPath]
    '           a valid path name
    'Return:    the same path with a "\" on the end if it did not already
    '           have one.
    '-------------------------------------------------------------------------
    If Right$(sPath, 1) <> "\" Then
        gFormatPath = sPath & "\"
    Else
        gFormatPath = sPath
    End If
End Function

Sub StopQueue()
    '-------------------------------------------------------------------------
    'Purpose:   Stops processing of Service Requests by deleging the pending
    '           requests
    'Assumes:   Assumes that clients have already stopped posting new requests
    '-------------------------------------------------------------------------
    LogEvent giSTOP_TEST_RECEIVED, 0
    DisplayStatus LoadResString(giSTOP_TEST_RECEIVED)
    Set gcQueue = Nothing
    Set gcQueue = New Collection
End Sub

Public Function SetWorkersOnMachine(bRemote As Boolean, sMachineName As String, lQuantityOnMachine As Long) As String
    '-------------------------------------------------------------------------
    'Purpose:   Sets the quantity of instanciated Workers on a particular machine
    'IN:
    '   [bRemote]
    '           If true adjust number of workers on a remote machine; else,
    '           adjust the number on the local machine.
    '   [sMachineName]
    '           Name of machine to adjust the level of instanciated Workers
    '   [lQuantityOnMachine]
    '           Number of Instantiated Workers that should be on specified
    '           machine.
    'Return:    Discription of Errors that should be displayed to user
    'Effects:
    '   [gcWorkers]
    '           The number of Workers in this collection will be adjusted
    '   [gcWorkerMachines]
    '           An item may be added or removed or edited
    '-------------------------------------------------------------------------
    Dim oRacReg As RacReg.RegClass          'Object to set automation connection settings
    Dim oWorkerMachine As clsWorkerMachines 'Object that stores how many workers are on
                                            'a machine, retrieved from global collection
    Dim lWorkerToRemove As Long             'ID of Worker found to remove
    Dim oWork As clsWorker                  'clsWorker object that hold reference to a Worker
                                            'and information related to it
    Dim oWorkerProvider As AEWorkerProvider.WorkerProvider  'Server that can be instanciated on remote
                                                            'machines to provide Worker objects
    Dim lAdd As Long                        'New ID for New Worker
    Dim sErrors As String                   'Discription of Errors that will be returned
    Dim bAddingWorker As Boolean            'If true, adding and configuring worker
                                            'used by error handling
    Dim iRetry As Integer                   'Error retry counter
    Dim iResult As Integer                  'RacReg error code

    On Error GoTo SetWorkersOnMachineError

    'Validate lQuantityOnMachine
    If lQuantityOnMachine < 0 Then lQuantityOnMachine = 0

    'Set registry for local or remote machine name
    Set oRacReg = New RacReg.RegClass
    If bRemote Then
        If gbUseDCOM Then
            iResult = oRacReg.SetDCOMServerSettings(True, "AEWorkerProvider.WorkerProvider", , sMachineName)
        Else
            iResult = oRacReg.SetAutoServerSettings(True, "AEWorkerProvider.WorkerProvider", , sMachineName, gsProtocol, glAuthentication)
        End If
    Else
        'Make sure the Machine name string is zero length
        sMachineName = ""
        'Make sure AEWorker.Worker is registered for local instanciation
        'Because Clients may have been run on this machine and may have
        'left the connection settings remote if they did not unload properly
        iResult = oRacReg.SetAutoServerSettings(False, "AEWorker.Worker")

    End If
    If iResult <> 0 Then GoTo SetWorkersOnMachine_RacRegError

    'Get the clsWorkerMachines object to store information in
    If Not bRemote Then
        'it is definitely the first item in the collection
        Set oWorkerMachine = gcWorkerMachines.Item(1)
    Else
        'if it is in the collection it is stored by a key
        'equaling the machine name
        'If error equals ERR_INVALID_PROCEDURE_CALL there
        'are no Workers on specified machine and no clsWorkerMachines
        'class object to represent them
        On Error Resume Next
        Set oWorkerMachine = gcWorkerMachines.Item(sMachineName)
        If Err.Number = ERR_INVALID_PROCEDURE_CALL Then
            On Error GoTo SetWorkersOnMachineError
            'Don't create a new clsWorkerMachine object of
            'lQuantityOnMachine is zero
            If lQuantityOnMachine <= 0 Then Exit Function
            Set oWorkerMachine = New clsWorkerMachines
            'If an error occurs creating WorkerProvider the current machine name
            'can not be used.  Treat error as if a Worker can not be created on
            'paticular machine.
            bAddingWorker = True
            Set oWorkerMachine.WorkerProvider = New AEWorkerProvider.WorkerProvider
            bAddingWorker = False
            gcWorkerMachines.Add oWorkerMachine, sMachineName
            With oWorkerMachine
                .Remote = True
                .MachineName = sMachineName
            End With
        End If
        On Error GoTo SetWorkersOnMachineError
        Set oWorkerProvider = oWorkerMachine.WorkerProvider
    End If

    'Now see if more workers need destroyed on this machine
    With oWorkerMachine
        If .WorkerKeys.Count > lQuantityOnMachine Then
            Do Until .WorkerKeys.Count <= lQuantityOnMachine
                'Find a worker on this machine
                lWorkerToRemove = .WorkerKeys.Item(1)
                .WorkerKeys.Remove 1
                'Remove the found worker
                'Do not destroy the Worker if it is busy
                'instead just flip its RemoveMe flag
                giWorkerCount = giWorkerCount - 1
                If gcWorkers.Item(CStr(lWorkerToRemove)).Busy Then
                    gcWorkers.Item(CStr(lWorkerToRemove)).RemoveMe = True
                Else
                    iRetry = 0
                    gcWorkers.Item(CStr(lWorkerToRemove)).Worker.ShutDown
                    Set gcWorkers.Item(CStr(lWorkerToRemove)).Worker = Nothing
                    gcWorkers.Remove CStr(lWorkerToRemove)
                End If
            Loop
        Else
            'Else lQuantityOnMachine must be greater than .WorkerKeys.count
            'So add to the collection
            bAddingWorker = True
            Do Until .WorkerKeys.Count = lQuantityOnMachine
                'Choose a unique key
                lAdd = glLastKeyUsed + 1
                glLastKeyUsed = lAdd
                Set oWork = New clsWorker
                oWork.Busy = False
                'Get a new Worker object
                If bRemote Then
                    Set oWork.Worker = oWorkerProvider.GetWorker
                Else
                    Set oWork.Worker = New AEWorker.Worker
                End If
                'Set the WorkerID property of AEWorker.Worker
                'Set the new worker property to the properties
                'that have been set for the any other workers
                iRetry = 0
                oWork.Worker.SetProperties gbLogWorkers, gbEarlyBindServices, _
                        gbPersistentServices, lAdd
                'Add the clsWorker class object which holds a
                'reference to the Worker class object to gcWorkers collection
                'Use the WorkerID as the key
                gcWorkers.Add oWork, CStr(lAdd)
                giWorkerCount = giWorkerCount + 1
                .WorkerKeys.Add lAdd
                iRetry = 0
                Set oWork.Worker.QueueMgrRef = New clsQueueDelegator
                oWork.Worker.StartPollingQueue
            Loop
            bAddingWorker = False
        End If
    End With
SetWorkersOnMachineEnd:
    'Update the WorkerCount label in the U/I
    'Set connection settings back to local
    iResult = oRacReg.SetAutoServerSettings(False, "AEWorkerProvider.WorkerProvider")
    If iResult <> 0 Then GoTo SetWorkersOnMachine_RacRegError

    If gbShow Then
        With frmQueueMgr.lblWorkerCount
            .Caption = gcWorkers.Count
            .Refresh
        End With
    End If

    'If the WorkerKeys.count = 0 and bRemote is true
    'then the clsWorkerMachines class
    'object in gcWorkerMachines should be removed
    'Don't remove the clsWorkerMachines object representing the
    'local machine.  Index one is reserved for the local machine.
    If oWorkerMachine.WorkerKeys.Count = 0 And bRemote Then
        On Error Resume Next
        gcWorkerMachines.Remove sMachineName
    End If
    SetWorkersOnMachine = sErrors
    Exit Function

SetWorkersOnMachine_RacRegError:
    Err.Raise giCONNECTION_SETTING_FAILED

SetWorkersOnMachineError:
    Select Case Err.Number
        Case RPC_E_CALL_REJECTED
            'Collision error, the OLE server is busy
            Dim il As Integer
            Dim ir As Integer
            'First check for stop test
            If iRetry < giMAX_ALLOWED_RETRIES Then
                iRetry = iRetry + 1
                ir = Int((giRETRY_WAIT_MAX - giRETRY_WAIT_MIN + 1) * Rnd + giRETRY_WAIT_MIN)
                For il = 0 To ir
                    DoEvents
                Next il
                LogEvent giCALL_REJECTED_RETRY, 0
                Resume
            Else
                'We reached our max retries
                GoTo SetWorkersOnMachineUnexpectedError
            End If
        Case ERR_CANT_FIND_KEY_IN_REGISTRY
            'AEInstancer.Instancer is a work around for error
            '-2147221166 which occurrs every time a client
            'object creates an instance of a remote server,
            'destroys it, registers it local, and tries to
            'create a local instance.  The client can not
            'create an object registered locally after it created
            'an instance while it was registered remotely
            'until it shuts down and restarts.  Therefore,
            'it works to call another process to create the
            'local instance and pass it back.
            Dim oInstancer As AEInstancer.Instancer
            Set oInstancer = New AEInstancer.Instancer
            Set oWorkerProvider = oInstancer.Object("AEWorkerProvider.WorkerProvider")
            Set oInstancer = Nothing
            Resume Next
        Case RPC_S_UNKNOWN_AUTHN_TYPE
            'Tried to connect to a server that does not support
            'specified authentication level.  Display message and
            'switch to no authentication and try again
            Dim s As String
            s = sMachineName & gsSEPERATOR & LoadResString(giUSING_NO_AUTHENTICATION)
            LogText s, 0
            sErrors = s & vbCrLf
            iResult = oRacReg.SetAutoServerSettings(True, "AEWorkerProvider.WorkerProvider", , sMachineName, gsProtocol, glAUTHENTICATION_DEFAULT)
            Resume
        Case ERR_OVER_FLOW
            glLastKeyUsed = 0
            Resume
        Case ERR_DUPLICATE_KEY
            'Assusmes on line "gcWorkers.Add oWork, cstr(lAdd)"
            If lAdd = glMAX_ID Then lAdd = 0 Else lAdd = lAdd + 1
            glLastKeyUsed = lAdd
            oWork.ID = lAdd
            Resume
        Case giCONNECTION_SETTING_FAILED
            sErrors = ReplaceString(LoadResString(giCONNECTION_SETTING_FAILED), gsNAME_TOKEN, LoadResString(giRACREG_ERROR_CODE_OFFSET + iResult))
            Err.Raise giNO_WORKERS_CREATED, , sErrors & vbCrLf & LoadResString(giNO_WORKERS_CREATED)
        Case Else
SetWorkersOnMachineUnexpectedError:
            'There are three cases to respond to if there is an unexpected error
            '1- If the error occured while NOT adding a worker it most likely
            '   occured while removing one.  Resume Next to insure that the worker
            '   is removed from the workers collection.
            '2- If we were adding a worker and the worker class was registered local
            '   log the error, and add it to the sError string, but raise the
            '   giNO_WORKERS_CREATED error, because the system has a critical problem
            '   if a local worker can not be created.
            '3- If we were adding a worker and the worker class was registered remote
            '   log the error, and add it to the sError string.  Exit procedure so
            '   that calling procedure can try creating workers on another machine
            Dim sSource As String
            sSource = Err.Source
            sErrors = sErrors & sMachineName & gsSEPERATOR & sSource & gsSEPERATOR & Err.Description & vbCrLf
            LogError Err, 0
            If Not bAddingWorker Then
                Resume Next
            Else
                If bRemote Then
                    sErrors = sErrors & vbCrLf & ReplaceString(LoadResString(giCOULD_NOT_CREATE_WORKER_ON_MACHINE), gsNAME_TOKEN, sMachineName)
                    Resume SetWorkersOnMachineEnd
                Else
                    iResult = oRacReg.SetAutoServerSettings(False, "AEWorkerProvider.WorkerProvider")
                    sErrors = sErrors & vbCrLf & LoadResString(giCOULD_NOT_CREATE_LOCAL_WORKER)
                    Err.Raise giNO_WORKERS_CREATED, sSource, sErrors & vbCrLf & LoadResString(giNO_WORKERS_CREATED)
                End If
            End If
    End Select
End Function